home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / lib / blt2.4 / hierbox.tcl < prev    next >
Encoding:
Text File  |  2009-12-04  |  13.3 KB  |  523 lines

  1. #
  2. # hierbox.tcl
  3. # ----------------------------------------------------------------------
  4. # Bindings for the BLT hierbox widget
  5. # ----------------------------------------------------------------------
  6. #   AUTHOR:  George Howlett
  7. #            Bell Labs Innovations for Lucent Technologies
  8. #            gah@lucent.com
  9. #            http://www.tcltk.com/blt
  10. #
  11. #      RCS:  $Id: hierbox.tcl,v 1.1 2002/02/03 20:00:43 ghowlett Exp $
  12. #
  13. # ----------------------------------------------------------------------
  14. # Copyright (c) 1998  Lucent Technologies, Inc.
  15. # ======================================================================
  16. #
  17. # Permission to use, copy, modify, and distribute this software and its
  18. # documentation for any purpose and without fee is hereby granted,
  19. # provided that the above copyright notice appear in all copies and that
  20. # both that the copyright notice and warranty disclaimer appear in
  21. # supporting documentation, and that the names of Lucent Technologies
  22. # any of their entities not be used in advertising or publicity
  23. # pertaining to distribution of the software without specific, written
  24. # prior permission.
  25. #
  26. # Lucent Technologies disclaims all warranties with regard to this
  27. # software, including all implied warranties of merchantability and
  28. # fitness.  In no event shall Lucent be liable for any special, indirect
  29. # or consequential damages or any damages whatsoever resulting from loss
  30. # of use, data or profits, whether in an action of contract, negligence
  31. # or other tortuous action, arising out of or in connection with the use
  32. # or performance of this software.
  33. #
  34. # ======================================================================
  35.  
  36. array set bltHierbox {
  37.     afterId ""
  38.     scroll  0
  39.     space   off
  40.     x       0
  41.     y       0
  42. }
  43.  
  44. catch { 
  45.     namespace eval blt::Hierbox {} 
  46. }
  47.  
  48. # ButtonPress assignments
  49. #
  50. #    B1-Enter    start auto-scrolling
  51. #    B1-Leave    stop auto-scrolling
  52. #    ButtonPress-2    start scan
  53. #    B2-Motion    adjust scan
  54. #    ButtonRelease-2 stop scan
  55. #
  56.  
  57. bind Hierbox <ButtonPress-2> {
  58.     set bltHierbox(cursor) [%W cget -cursor]
  59.     %W configure -cursor hand1
  60.     %W scan mark %x %y
  61. }
  62.  
  63. bind Hierbox <B2-Motion> {
  64.     %W scan dragto %x %y
  65. }
  66.  
  67. bind Hierbox <ButtonRelease-2> {
  68.     %W configure -cursor $bltHierbox(cursor)
  69. }
  70.  
  71. bind Hierbox <B1-Leave> {
  72.     if { $bltHierbox(scroll) } {
  73.     blt::Hierbox::AutoScroll %W 
  74.     }
  75. }
  76.  
  77. bind Hierbox <B1-Enter> {
  78.     after cancel $bltHierbox(afterId)
  79. }
  80.  
  81.  
  82. # KeyPress assignments
  83. #
  84. #    Up            
  85. #    Down
  86. #    Shift-Up
  87. #    Shift-Down
  88. #    Prior (PageUp)
  89. #    Next  (PageDn)
  90. #    Left
  91. #    Right
  92. #    space        Start selection toggle of entry currently with focus.
  93. #    Return        Start selection toggle of entry currently with focus.
  94. #    Home
  95. #    End
  96. #    F1
  97. #    F2
  98. #    ASCII char    Go to next open entry starting with character.
  99. #
  100. # KeyRelease
  101. #
  102. #    space        Stop selection toggle of entry currently with focus.
  103. #    Return        Stop selection toggle of entry currently with focus.
  104.  
  105.  
  106. bind Hierbox <KeyPress-Up> {
  107.     blt::Hierbox::MoveFocus %W up
  108.     if { $bltHierbox(space) } {
  109.     %W selection toggle focus
  110.     }
  111. }
  112.  
  113. bind Hierbox <KeyPress-Down> {
  114.     blt::Hierbox::MoveFocus %W down
  115.     if { $bltHierbox(space) } {
  116.     %W selection toggle focus
  117.     }
  118. }
  119.  
  120. bind Hierbox <Shift-KeyPress-Up> {
  121.     blt::Hierbox::MoveFocus %W prevsibling
  122. }
  123.  
  124. bind Hierbox <Shift-KeyPress-Down> {
  125.     blt::Hierbox::MoveFocus %W nextsibling
  126. }
  127.  
  128. bind Hierbox <KeyPress-Prior> {
  129.     blt::Hierbox::MovePage %W top
  130. }
  131.  
  132. bind Hierbox <KeyPress-Next> {
  133.     blt::Hierbox::MovePage %W bottom
  134. }
  135.  
  136. bind Hierbox <KeyPress-Left> {
  137.     %W close focus
  138. }
  139. bind Hierbox <KeyPress-Right> {
  140.     %W open focus
  141.     %W see focus -anchor w
  142. }
  143.  
  144. bind Hierbox <KeyPress-space> {
  145.     blt::HierboxToggle %W focus
  146.     set bltHierbox(space) on
  147. }
  148.  
  149. bind Hierbox <KeyRelease-space> { 
  150.     set bltHierbox(space) off
  151. }
  152.  
  153. bind Hierbox <KeyPress-Return> {
  154.     blt::HierboxToggle %W focus
  155.     set bltHierbox(space) on
  156. }
  157.  
  158. bind Hierbox <KeyRelease-Return> { 
  159.     set bltHierbox(space) off
  160. }
  161.  
  162. bind Hierbox <KeyPress> {
  163.     blt::Hierbox::NextMatchingEntry %W %A
  164. }
  165.  
  166. bind Hierbox <KeyPress-Home> {
  167.     blt::Hierbox::MoveFocus %W root
  168. }
  169.  
  170. bind Hierbox <KeyPress-End> {
  171.     blt::Hierbox::MoveFocus %W end
  172. }
  173.  
  174. bind Hierbox <KeyPress-F1> {
  175.     %W open -r root
  176. }
  177.  
  178. bind Hierbox <KeyPress-F2> {
  179.     eval %W close -r [%W entry children root 0 end] 
  180. }
  181.  
  182. # ----------------------------------------------------------------------
  183. # USAGE: blt::HierboxToggle <hierbox> <index>
  184. # Arguments:    hierbox        hierarchy widget
  185. #
  186. # Invoked when the user presses the space bar.  Toggles the selection
  187. # for the entry at <index>.
  188. # ----------------------------------------------------------------------
  189. proc blt::HierboxToggle { widget index } {
  190.     switch -- [$widget cget -selectmode] {
  191.         single {
  192.             if { [$widget selection includes $index] } {
  193.                 $widget selection clearall
  194.             } else {
  195.         $widget selection set $index
  196.         }
  197.         }
  198.         multiple {
  199.             $widget selection toggle $index
  200.         }
  201.     }
  202. }
  203.  
  204.  
  205. # ----------------------------------------------------------------------
  206. # USAGE: blt::Hierbox::MovePage <hierbox> <where>
  207. # Arguments:    hierbox        hierarchy widget
  208. #
  209. # Invoked by KeyPress bindings.  Pages the current view up or down.
  210. # The <where> argument should be either "top" or "bottom".
  211. # ----------------------------------------------------------------------
  212.  
  213. proc blt::Hierbox::MovePage { widget where } {
  214.     # If the focus is already at the top/bottom of the window, we want
  215.     # to scroll a page. It's really one page minus an entry because we
  216.     # want to see the last entry on the next/last page.
  217.     if { [$widget index focus] == [$widget index view.$where] } {
  218.         if {$where == "top"} {
  219.         $widget yview scroll -1 pages
  220.         $widget yview scroll 1 units
  221.         } else {
  222.         $widget yview scroll 1 pages
  223.         $widget yview scroll -1 units
  224.         }
  225.     }
  226.     update
  227.  
  228.     # Adjust the entry focus and the view.  Also activate the entry.
  229.     # just in case the mouse point is not in the widget.
  230.     $widget entry highlight view.$where
  231.     $widget focus view.$where
  232.     $widget see view.$where
  233.     if { [$widget cget -selectmode] == "single" } {
  234.         $widget selection clearall
  235.         $widget selection set focus
  236.     }
  237. }
  238.  
  239. #
  240. #  Edit mode assignments
  241. #
  242. #    ButtonPress-3   Enables/disables edit mode on entry.  Sets focus to 
  243. #            entry.
  244. #
  245. #  KeyPress
  246. #
  247. #    Left        Move insertion position to previous.
  248. #    Right        Move insertion position to next.
  249. #    Up        Move insertion position up one line.
  250. #    Down        Move insertion position down one line.
  251. #    Return        End edit mode.
  252. #    Shift-Return    Line feed.
  253. #    Home        Move to first position.
  254. #    End        Move to last position.
  255. #    ASCII char    Insert character left of insertion point.
  256. #    Del        Delete character right of insertion point.
  257. #    Delete        Delete character left of insertion point.
  258. #    Ctrl-X        Cut
  259. #    Ctrl-V        Copy
  260. #    Ctrl-P        Paste
  261. #    
  262. #  KeyRelease
  263. #
  264. #  ButtonPress-1    Start selection if in entry, otherwise clear selection.
  265. #  B1-Motion        Extend/reduce selection.
  266. #  ButtonRelease-1      End selection if in entry, otherwise use last selection.
  267. #  B1-Enter        Disabled.
  268. #  B1-Leave        Disabled.
  269. #  ButtonPress-2    Same as above.
  270. #  B2-Motion        Same as above.
  271. #  ButtonRelease-2    Same as above.
  272. #    
  273. # All bindings in editting mode will "break" to override other bindings.
  274. #
  275. #
  276.  
  277. bind Hierbox <ButtonPress-3> {
  278.     set node [%W nearest %x %y]
  279.     %W entry insert $node @%x,%y ""
  280. #    %W entry insert $node 2 ""
  281. }
  282.  
  283.  
  284. proc blt::Hierbox::Init { widget } {
  285.     #
  286.     # Active entry bindings
  287.     #
  288.     $widget bind Entry <Enter> { 
  289.     %W entry highlight current 
  290.     }
  291.     $widget bind Entry <Leave> { 
  292.     %W entry highlight "" 
  293.     }
  294.  
  295.     #
  296.     # Button bindings
  297.     #
  298.     $widget button bind all <ButtonRelease-1> {
  299.     %W see -anchor nw current
  300.     %W toggle current
  301.     }
  302.     $widget button bind all <Enter> {
  303.     %W button highlight current
  304.     }
  305.     $widget button bind all <Leave> {
  306.     %W button highlight ""
  307.     }
  308.  
  309.     #
  310.     # ButtonPress-1
  311.     #
  312.     #    Performs the following operations:
  313.     #
  314.     #    1. Clears the previous selection.
  315.     #    2. Selects the current entry.
  316.     #    3. Sets the focus to this entry.
  317.     #    4. Scrolls the entry into view.
  318.     #    5. Sets the selection anchor to this entry, just in case
  319.     #       this is "multiple" mode.
  320.     #
  321.     
  322.     $widget bind Entry <ButtonPress-1> {     
  323.     blt::Hierbox::SetSelectionAnchor %W current
  324.     set bltHierbox(scroll) 1
  325.     }
  326.  
  327.     $widget bin Entry <Double-ButtonPress-1> {
  328.     %W toggle current
  329.     }
  330.  
  331.     #
  332.     # B1-Motion
  333.     #
  334.     #    For "multiple" mode only.  Saves the current location of the
  335.     #    pointer for auto-scrolling.
  336.     #
  337.     $widget bind Entry <B1-Motion> { 
  338.     set bltHierbox(x) %x
  339.     set bltHierbox(y) %y
  340.     set index [%W nearest %x %y]
  341.     if { [%W cget -selectmode] == "multiple" } {
  342.         %W selection mark $index
  343.     } else {
  344.         blt::Hierbox::SetSelectionAnchor %W $index
  345.     }        
  346.     }
  347.  
  348.     #
  349.     # ButtonRelease-1
  350.     #
  351.     #    For "multiple" mode only.  
  352.     #
  353.     $widget bind Entry <ButtonRelease-1> { 
  354.     if { [%W cget -selectmode] == "multiple" } {
  355.         %W selection anchor current
  356.     } 
  357.     after cancel $bltHierbox(afterId)
  358.     set bltHierbox(scroll) 0
  359.     }
  360.  
  361.     #
  362.     # Shift-ButtonPress-1
  363.     #
  364.     #    For "multiple" mode only.
  365.     #
  366.     $widget bind Entry <Shift-ButtonPress-1> { 
  367.     if { [%W cget -selectmode] == "multiple" && [%W selection present] }  {
  368.         if { [%W index anchor] == "" } {
  369.         %W selection anchor current
  370.         }
  371.         set index [%W index anchor]
  372.         %W selection clearall
  373.         %W selection set $index current
  374.     } else {
  375.         blt::Hierbox::SetSelectionAnchor %W current
  376.     }
  377.     }
  378.     $widget bind Entry <Shift-B1-Motion> { 
  379.     # do nothing
  380.     }
  381.     $widget bind Entry <Shift-ButtonRelease-1> { 
  382.     after cancel $bltHierbox(afterId)
  383.     set bltHierbox(scroll) 0
  384.     }
  385.  
  386.     #
  387.     # Control-ButtonPress-1
  388.     #
  389.     #    For "multiple" mode only.  
  390.     #
  391.     $widget bind Entry <Control-ButtonPress-1> { 
  392.     if { [%W cget -selectmode] == "multiple" } {
  393.         set index [%W index current]
  394.         %W selection toggle $index
  395.         %W selection anchor $index
  396.     } else {
  397.         blt::Hierbox::SetSelectionAnchor %W current
  398.     }
  399.     }
  400.     $widget bind Entry <Control-B1-Motion> { 
  401.     # do nothing
  402.     }
  403.     $widget bind Entry <Control-ButtonRelease-1> { 
  404.     after cancel $bltHierbox(afterId)
  405.     set bltHierbox(scroll) 0
  406.     }
  407.     #
  408.     # Control-Shift-ButtonPress-1
  409.     #
  410.     #    For "multiple" mode only.  
  411.     #
  412.     $widget bind Entry <Control-Shift-ButtonPress-1> { 
  413.     if { [%W cget -selectmode] == "multiple" && [%W selection present] } {
  414.         if { [%W index anchor] == "" } {
  415.         %W selection anchor current
  416.         }
  417.         if { [%W selection includes anchor] } {
  418.         %W selection set anchor current
  419.         } else {
  420.         %W selection clear anchor current
  421.         %W selection set current
  422.         }
  423.     } else {
  424.         blt::Hierbox::SetSelectionAnchor %W current
  425.     }
  426.     }
  427.     $widget bind Entry <Control-Shift-B1-Motion> { 
  428.     # do nothing
  429.     }
  430. }
  431.  
  432.  
  433. # ----------------------------------------------------------------------
  434. # USAGE: blt::Hierbox::AutoScroll <hierbox>
  435. #
  436. # Invoked when the user is selecting elements in a hierbox widget
  437. # and drags the mouse pointer outside of the widget.  Scrolls the
  438. # view in the direction of the pointer.
  439. #
  440. # Arguments:    hierbox        hierarchy widget
  441. #
  442. # ----------------------------------------------------------------------
  443. proc blt::Hierbox::AutoScroll { widget } {
  444.     global bltHierbox
  445.     if { ![winfo exists $widget] } {
  446.     return
  447.     }
  448.     set x $bltHierbox(x)
  449.     set y $bltHierbox(y)
  450.     set index [$widget nearest $x $y]
  451.     if { $y >= [winfo height $widget] } {
  452.     $widget yview scroll 1 units
  453.     set neighbor down
  454.     } elseif { $y < 0 } {
  455.     $widget yview scroll -1 units
  456.     set neighbor up
  457.     } else {
  458.     set neighbor $index
  459.     }
  460.     if { [$widget cget -selectmode] == "single" } {
  461.     blt::Hierbox::SetSelectionAnchor $widget $neighbor
  462.     } else {
  463.     $widget selection mark $index
  464.     }
  465.     set bltHierbox(afterId) [after 10 blt::Hierbox::AutoScroll $widget]
  466. }
  467.  
  468. proc blt::Hierbox::SetSelectionAnchor { widget index } {
  469.     set index [$widget index $index]
  470.     $widget selection clearall
  471.     $widget see $index
  472.     $widget focus $index
  473.     $widget selection set $index
  474.     $widget selection anchor $index
  475. }
  476.  
  477.  
  478. # ----------------------------------------------------------------------
  479. # USAGE: blt::Hierbox::NextMatchingEntry <hierbox> <char>
  480. # Arguments:    hierbox        hierarchy widget
  481. #
  482. # Invoked by KeyPress bindings.  Searches for an entry that starts
  483. # with the letter <char> and makes that entry active.
  484. # ----------------------------------------------------------------------
  485.  
  486. proc blt::Hierbox::NextMatchingEntry { widget key } {
  487.     if {[string match {[ -~]} $key]} {
  488.     set last [$widget index focus]
  489.     set next [$widget index next]
  490.     while { $next != $last } {
  491.         set label [$widget entry cget $next -label]
  492.         if { [string index $label 0] == $key } {
  493.         break
  494.         }
  495.         set next [$widget index -at $next next]
  496.     }
  497.     $widget focus $next
  498.         if {[$widget cget -selectmode] == "single"} {
  499.             $widget selection clearall
  500.             $widget selection set focus
  501.         }
  502.     $widget see focus
  503.     }
  504. }
  505.  
  506. # ----------------------------------------------------------------------
  507. # USAGE: blt::Hierbox::MoveFocus <hierbox> <where>
  508. #
  509. # Invoked by KeyPress bindings.  Moves the active selection to the
  510. # entry <where>, which is an index such as "up", "down", "prevsibling",
  511. # "nextsibling", etc.
  512. # ----------------------------------------------------------------------
  513. proc blt::Hierbox::MoveFocus { widget where } {
  514.     catch {$widget focus $where}
  515.     if { [$widget cget -selectmode] == "single" } {
  516.         $widget selection clearall
  517.         $widget selection set focus
  518.     }
  519.     $widget see focus
  520. }
  521.